home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / sys_util / shell / shell.bas
Encoding:
BASIC Source File  |  1995-10-30  |  2.9 KB  |  64 lines
  1. Attribute VB_Name = "Shell"
  2.  
  3. '************************************************************************************************************
  4. '  PROCESS STUFF
  5. '************************************************************************************************************
  6. Public Const PROCESS_QUERY_INFORMATION = &H400
  7. Public Const PROCESS_TERMINATE = &H1
  8. Public Const STILL_ACTIVE = &H103
  9. 'THE REMAINING CONSTANTS FOUND IN WINNT.H
  10.  
  11. Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess&, ByVal bInheritHandle&, ByVal dwProcessId&) As Long
  12. Public Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
  13. Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
  14.  
  15.  
  16. Sub ShellAndWait(strApp As String)
  17. '***********************************************************************************************
  18. ' PURPOSE:      to shell to an app, wait for it to finish and then come back
  19. '               only a 32 bit app.  Do not use TerminateProcess for app that loads .dlls but works
  20. '               great for virtual dos sessons.
  21.  
  22. ' EFFECTS:      the app shelled to and program execution here
  23. ' INPUTS:       the path and file name to the shelled app
  24. ' RETURNS:      Nothing
  25. ' CALLED FROM:
  26. ' AUTHOR DATE:  BruceJackson 10/95
  27. '***********************************************************************************************
  28. On Error GoTo ShellAndWait_Err
  29. Dim lngShellReturn As Long
  30. Dim lngOpenProcess As Long
  31. Dim lngExit As Long
  32. Dim lngTimer As Long
  33. Dim msg As String
  34. Const NOWINDOW = 0
  35. Const WINDOWED = 1
  36. Dim r
  37. '***********************************************************************************************
  38.     lngShellReturn = Shell(strApp, WINDOW)                 ' OPENS WITH WINDOW, USE NOWINDOW FOR HIDDEND
  39.     lngTimer = Timer
  40.     lngOpenProcess = OpenProcess(PROCESS_QUERY_INFORMATION + PROCESS_TERMINATE, False, lngShellReturn)
  41. Back:
  42.     Call GetExitCodeProcess(lngOpenProcess, lngExit)
  43.     If lngExit = STILL_ACTIVE Then
  44.         If Timer - lngTimer > 120 Then                                         ' only wait for two minutes
  45.             msg = "An application has timed out!" & vbCrLf
  46.             msg = msg & "The path and file name to the batch file is: " & strApp
  47.             ' can also use ExitProcess
  48.             r = TerminateProcess(lngOpenProcess, lngExit)                      ' FOR DOS APPS THAT DON'T CALL DLLS ONLY
  49.             MsgBox msg, 64, "Time Out Error"
  50.             Exit Sub
  51.         End If
  52.         If lngTimer > Timer Then lngTimer = Timer                              ' adjust after midnight
  53.         DoEvents
  54.         GoTo Back
  55.     End If
  56. '***********************************************************************************************
  57. ShellAndWait_bye:
  58.     Exit Sub
  59. ShellAndWait_Err:
  60.     MsgBox "ERROR: " & Error$ & Chr$(13) & Chr$(10) & "ERR#:  " & Err, 64, "ShellAndWait"
  61.     GoTo ShellAndWait_bye
  62. End Sub
  63.  
  64.